Image Processing in Mathematica

Markus van Almsick & Shadi Ashnai

Wolfram Research Inc.

Bring an Image into Mathematica

blossom = Import["http://www.umax.com/assets/astrapix630/fullsize/RedBlossom.jpg"]

image = ImageResize[blossom,640]

A simple task: Segment the Flower (Mathematica 7 version)

b=Binarize[image,Norm[#-{1,0,0}]<.5&]

ColorCombine[{image,b}]

Improved segmentation in Mathematica 8

b = ChanVeseBinarize[image,"TargetColor"->Red]

filled = FillingTransform[b]

clean = DeleteSmallComponents[filled]

skeleton = SkeletonTransform[clean,"Reduced"->True]

segment = InverseDistanceTransform[Pruning[skeleton,1,10]]

SetAlphaChannel[image,segment]

Overview of Image Processing in Mathematica 8

Morphological Image Processing

Components, skeletons, extremas, hole filling, etc

Feature Detection

Lines/edges, points-of-interest, extrema, zeros & zero crossing detection, etc

Image Segmentation

Binary segmentation, image segmentation, segment analysis, etc

Image Transformation & Registration

General transformation, image alignment & matching

Image Restoration

Inpaint, smooth, remove noise, sharpen, etc

and more...

Text recognition

Live image capturing & processing

Region-of-interest processing

...

Overview of Image Processing in Mathematica 8

Image Morphology

Components, skeletons, extremas, hole filling, etc

Feature Detection

Lines/edges, points-of-interest, extrema, zeros & zero crossing detection, etc

Image Segmentation

Binary segmentation, image segmentation, segment analysis, etc

Image Transformation & Registration

General transformation, image alignment & matching

Image Restoration

Inpaint, smooth, remove noise, sharpen, etc

and more...

Text recognition

Live image capturing & processing

Region-of-interest processing

...

Count Legs of an Insect

skeleton = Thinning[]

endpoints = MorphologicalTransform[skeleton,"EndPoints"]

MorphologicalComponents[endpoints]//Max

Find Sickle Cells

i = ;

red = ColorSeparate[i,"Red"][[1]]

segmented = MinDetect[red,.1]

sickel = SelectComponents[segmented,"Elongation",#>0.45&]

ImageApply[1-#&,i,Masking->sickel]

Blob Analysis

i=;

segmented = Binarize[i,{0,.7}]

internal = DeleteBorderComponents[segmented]

clean = SelectComponents[internal,{"Area","Holes"},100<#1<2500 && #2>0 &]

Mean@ComponentMeasurements[clean,"Area"][[All,2]]//N

Show[i,Graphics[{Red,Thick,Circle[#[[1]],#[[2]]]&/@ComponentMeasurements[ImageMultiply[i,clean],{"Centroid","EquivalentDiskRadius"}][[All,2]]}]]

Overview of Image Processing in Mathematica 8

Morphological Image Processing

Components, skeletons, extremas, hole filling, etc

Feature Detection

Lines/edges, points-of-interest, extrema, zeros & zero crossing detection, etc

Image Segmentation

Binary segmentation, image segmentation, segment analysis, etc

Image Transformation & Registration

General transformation, image alignment & matching

Image Restoration

Inpaint, smooth, remove noise, sharpen, etc

and more...

Text recognition

Live image capturing & processing

Region-of-interest processing

...

Line Detection

img = ;

lines = ImageLines[Binarize[GradientFilter[img,1]],.2]

Show[img,Graphics[{Thick,Orange,Line/@lines}]]

Ridge Detection

Manipulate[DerivativeFilter[,{0,1},σ]//ImageAdjust,{σ,0.1,10}]

ridgeFilter[img_,σ_:1] := Module[
	{data = ImageData[img],Lx,Lxx,Lxy,Ly,Lyy},
	Lx = DerivativeFilter[data,{0,1},σ];
	Lxx=DerivativeFilter[data,{0,2},σ];
	Ly=DerivativeFilter[data,{1,0},σ];
	Lyy=DerivativeFilter[data,{2,0},σ];
	Lxy=DerivativeFilter[data,{1,1},σ];
	Image[
		Chop[((σ^(3/2))/2)(Lxx+Lyy - Sqrt[(Lxx - Lyy)^2+ 4 Lxy^2])]
	]
]

ridgeFilter[,5]//ImageAdjust

ridgeFilter[,2]//ImageAdjust

Extrema Detection

MinDetect[,.39]

Overview of Image Processing in Mathematica 8

Morphological Image Processing

Components, skeletons, extremas, hole filling, etc

Feature Detection

Lines/edges, points-of-interest, extrema, zeros & zero crossing detection, etc

Image Segmentation

Segmentation, object detection, segment analysis, etc

Image Transformation & Registration

General transformation, image alignment & matching

Image Restoration

Inpaint, smooth, remove noise, sharpen, etc

and more...

Text recognition

Live image capturing & processing

Region-of-interest processing

...

Trabacular Bone Segmentation

ReliefImage[]

(ws=WatershedComponents[])//Colorize

Histogram[ComponentMeasurements[ws,"Area"][[All,2]], {0,100,2}]

bone=ws// Image

MorphologicalGraph[ColorNegate[bone]]

Face Detection

{,,}

Dynamic[
Module[{image=CurrentImage[]},Show[image,Graphics[{EdgeForm[Directive[Thick,Red]],Transparent,Polygon[ComponentMeasurements[ImageData@DeleteSmallComponents@DeleteBorderComponents@ChanVeseBinarize[image,"TargetColor"->Pink,MaxIterations->10],"MinimalBoundingBox"][[1,2]]]}
]
]
]
]

Overview of Image Processing in Mathematica 8

Morphological Image Processing

Components, skeletons, extremas, hole filling, etc

Feature Detection

Lines/edges, points-of-interest, extrema, zeros & zero crossing detection, etc

Image Segmentation

Binary segmentation, image segmentation, segment analysis, etc

Image Transformation & Registration

General transformation, image alignment & matching

Image Restoration

Inpaint, smooth, remove noise, sharpen, etc

and more...

Text recognition

Live image capturing & processing

Region-of-interest processing

...

Image Distorting

lena = ExampleData[{"TestImage","Lena"}]

f[x_,y_]:=With[{r=N@Sqrt[(x-.5)^2+(y-.5)^2],a=ArcTan[x-.5,y-.5],R=.5},
rn=r*r/R;
{rn*Cos[a]+.5,rn*Sin[a]+.5}
];

ImageTransformation[lena,f[#[[1]],#[[2]]]&,Padding->"Reflected"]

Image Matching

images={ ,};

xy=ImageKeypoints[images[[1]]];
Show[Rasterize[images[[1]],"Graphics"],Graphics[{PointSize[Medium],Yellow,Point[xy]}]]

matches=ImageCorrespondingPoints[Sequence@@images];
Magnify[MapThread[Show[#1,Graphics[{Yellow,MapIndexed[Inset[#2[[1]],#1]& ,#2]}]]&,{images,matches}],2]

Image Stitching

i1 = ; i2 = ;
{w,h} = ImageDimensions[i2];

{e, t} = FindGeometricTransform[i1,i2]

i2transformed = ImagePerspectiveTransformation[i2,t,DataRange->Full,PlotRange->{{0,First@t[{w,0}]},{0,h}}]

ImageCompose[i2transformed,{i1,.5},Round[({w,h}/2)]]

Overview of Image Processing in Mathematica 8

Morphological Image Processing

Components, skeletons, extremas, hole filling, etc

Feature Detection

Lines/edges, points-of-interest, extrema, zeros & zero crossing detection, etc

Image Segmentation

Binary segmentation, image segmentation, segment analysis, etc

Image Transformation & Registration

General transformation, image alignment & matching

Image Restoration

Inpaint, smooth, remove noise, sharpen, etc

and more...

Text recognition

Live image capturing & processing

Region-of-interest processing

...

Inpainting

lincoln = ;

OrientedDerivativeFilter[img_,α_,σ_:1]:=
Module[
{Lxx=ImageData[DerivativeFilter[img,{0,2},σ]],
Lxy = ImageData[DerivativeFilter[img,{1,1},σ]],
Lyy=ImageData[DerivativeFilter[img,{2,0},σ]]},
Image[Cos[α]^2 Lxx + 2 Cos[α] Sin[α] Lxy + Sin[α]^2 Lyy]
]

Manipulate[OrientedDerivativeFilter[lincoln,α,0.5],{α,-90°,90°}]

mask1=EdgeDetect[ImageAdjust[OrientedDerivativeFilter[lincoln,80°]],2.5,0.12,"StraightEdges"-> 0.25]

mask2=EdgeDetect[ImageAdjust[OrientedDerivativeFilter[lincoln,160°]],2.5,0.11,"StraightEdges"-> 0.25]

mask=Dilation[ImageAdd[mask1,mask2], DiskMatrix[1]]

Inpaint[lincoln,mask]

Noise Removal

TraditionalForm[J[L[x]]==Integrate[Abs[∇L[x]],x] + (μ/2)Integrate[Abs[(Subscript[L, 0])[x]-L[x]],x]]

panteon = ;

noisy = ImageEffect[panteon,{"PoissonNoise",0.5}]

Magnify[ImageTake[noisy,{101,200},{101,200}],4]

clean = TotalVariationFilter[noisy,0.35,Method->"Poisson"]

Magnify[GraphicsRow[{ImageTake[noisy,{101,200},{101,200}],ImageTake[clean,{101,200},{101,200}]}],4]

“A” Soap Bubble in 2D

letter=Blur[ColorNegate[Rasterize[Graphics[Style[Text["A",{0,0}],FontFamily-> "Helvetica", FontSize-> 256], ImageSize-> 256]]],4]

mov=NestList[CurvatureFlowFilter[#,10]&,letter,80];

ListAnimate[Map[ColorNegate[MorphologicalPerimeter[#,0.1]]&,mov]]

Overview of Image Processing in Mathematica 8

Morphological Image Processing

Components, skeletons, extremas, hole filling, etc

Feature Detection

Lines/edges, points-of-interest, extrema, zeros & zero crossing detection, etc

Image Segmentation

Binary segmentation, image segmentation, segment analysis, etc

Image Transformation & Registration

General transformation, image alignment & matching

Image Restoration

Inpaint, smooth, remove noise, sharpen, etc

and (many) more...

Text recognition

Live image capturing & processing

Region-of-interest processing

...

Live Capturing & Processing

Dynamic[EdgeDetect[CurrentImage[]]]

Text Recognition

TextRecognize[]//Speak

TextRecognize[,Language-> "German"]

Improvements since Mathematica 7

Multi-threaded algorithms

Less memory consumption

More image types

Enhanced V7 functions

Added many more functions in various categories

With[{list={{ImageAdjust,0.88`,0.29`,0.13`},{Binarize,0.89`,0.79`,0.11`},{ImageMultiply,2.04`,1.64`,0.23`},{MaxFilter,2.33`,2.56`,0.87`},{ImageAdd,2.39`,2.49`,0.33`},{ImageSubtract,2.57`,2.09`,0.29`},{ImageResize,2.63`,2.31`,0.35`},{MedianFilter,13.27`,10.66`,1.98`},{CommonestFilter,19.1`,20.68`,4.68`},{EntropyFilter,37.12`,33.9`,5.42`},{Dilation,47.12`,13.89`,1.97`},{Erosion,47.19`,13.69`,1.92`}}},
Manipulate[BarChart[a list[[All,2]]+(1-a)If[t,list[[All,4]],list[[All,3]]],PlotRange->{0,50},AxesLabel->{None,"seconds"},ChartLabels->Placed[list[[All,1]],Axis,Rotate[#,Pi/3]&],ImageSize->640],{{a,1,"M7 vs M8"},1,0},{{t,False,"Multi-threads"},{False,True}}]]

Thanks

From the image processing team:

Jeremy Michelson
Jian Zhao
Jingyi Jin
Lambert Chao
Mariusz Jankowski
Markus van Almsick
Matthias Odisio
Maxim Rytin
Piotr Wendykier
Shadi Ashnai
Timothy Kirchner
Yu-Sung Chang

and Peter Overmann

Be a-Maze-d

i=;

w=Image[WatershedComponents[DistanceTransform[i]] ,"Bit"];
ImageApply[{.8,0,.8}&, i, Masking -> Dilation[ColorNegate[w],1]]